home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir43 / qsrc_dsk.zip / MODEL / WIDGMAIN.PRG < prev   
Text File  |  1992-01-15  |  16KB  |  473 lines
  1. *       ╓─────────────────────────────────────────────────────────╖
  2. *       ║                                                         ║
  3. *       ║ WIDGMAIN.PRG                                            ║
  4. *       ║                                                         ║
  5. *       ╟─────────────────────────────────────────────────────────╢
  6. *       ║ Application Developed in _Using FoxPro 2_               ║
  7. *       ║                                                         ║
  8. *       ║ Lisa C. Slater and Steven E. Arnott                     ║
  9. *       ║                                                         ║
  10. *       ║ Copyright (c) 1991 Que Publishing                       ║
  11. *       ║                                                         ║
  12. *       ╙─────────────────────────────────────────────────────────╜
  13.  
  14. * main program for second WIDGET application,
  15. * demonstrating normal/recommended program
  16. * "flow" and foundation READ usage.
  17.  
  18. * all additional subroutines necessary to support
  19. * this revision of the application are included 
  20. * "bound" into this file.
  21.  
  22. DO setup
  23. DO widglogo.spr
  24. DO widget2.mpr
  25.  
  26. m.quit = .f.
  27.  
  28. * this KEYBOARD force "About Widget... " window 
  29. * to come up on the way
  30. * into the foundation READ
  31. KEYBOARD "{ALT-S}{W}"
  32.  
  33. READ VALID m.quit
  34.  
  35. DO cleanup
  36.  
  37. ************************************************************************
  38.  
  39. PROC setup
  40. ACTIVATE SCREEN
  41. PUSH KEY CLEAR
  42. PUSH MENU _MSYSMENU
  43. PUBLIC m.resource, m.oldresource, m.help, m.oldhelp, m.got_cancel,;
  44.        m.olderror, m.oldtalk, m.oldvue, m.oldsafe, m.oldfull
  45. IF SET("TALK") = "ON"
  46.    SET TALK OFF
  47.    m.oldtalk = "ON"
  48. ENDIF
  49. CLEAR
  50. m.oldvue = SYS(3)+".vue"
  51. DO WHILE FILE(m.oldvue)
  52.    m.oldvue = SYS(3)+".vue"
  53. ENDDO
  54. CREATE VIEW (m.oldvue)   
  55. * should also create an array to save
  56. * record pointers here if you feel the surrounding
  57. * environment requires that degree of protection
  58. CLOSE DATA
  59. m.resource = SET("RESOURCE")
  60. m.oldresource = SET("RESOURCE",1)
  61. m.help = SET("HELP")
  62. m.oldhelp = SET("HELP",1)
  63. m.olderror = IIF(EMPTY(ON("ERROR")), " ", ON("ERROR"))
  64. m.oldsafe = SET("SAFETY")
  65. m.oldfull = SET("FULLPATH")
  66. SET RESOURCE ON
  67. SET RESOURCE TO W_USER
  68. SET FULLPATH ON
  69. SET HELP ON
  70. SET HELP TO Widghelp
  71. ON ERROR DO Widgerror WITH ;
  72.          LINENO(1), PROGRAM(), ;
  73.          MESSAGE(), MESSAGE(1), ERROR(), ;
  74.          WLAST(), WREAD(), WONTOP(), RDLEVEL()
  75. SET SYSMENU AUTOMATIC
  76. SET SAFETY OFF
  77. RETURN
  78.  
  79. PROC cleanup
  80. IF "SUPPORT" $ UPPER(VERSION(1))
  81.     * DO any necessary cleanup
  82.     QUIT
  83. ELSE
  84.     POP MENU _MSYSMENU
  85.     IF FILE(m.oldresource)
  86.         * if RESOURCE was SET OFF in CONFIG.FP,
  87.         * the file pointed to might not exist
  88.         SET RESOURCE TO (m.oldresource)
  89.     ENDIF  
  90.     IF m.resource = "OFF"
  91.       SET RESOURCE OFF
  92.     ENDIF
  93.     IF FILE(m.oldhelp)
  94.        SET HELP TO (m.oldhelp)
  95.     ENDIF  
  96.     IF m.help = "OFF"
  97.        SET HELP OFF
  98.     ENDIF
  99.     ON ERROR &olderror
  100.     IF ! EMPTY(m.oldtalk)
  101.        SET TALK ON
  102.     ENDIF       
  103.     SET SAFETY &oldsafe
  104.     SET VIEW TO (m.oldvue)
  105.     ERASE (m.oldvue)
  106.     SET FULLPATH &oldfull
  107.     RELEASE m.resource, m.oldresource, m.help, m.oldhelp, m.got_cancel,;
  108.             m.olderror, m.oldtalk, m.oldvue, m.oldsafe, m.oldfull
  109.     
  110.     * the following are PUBLIC vars setup by FoxApp that
  111.     * don't get properly released by FoxApp itself:
  112.  
  113.     RELEASE bailout, dbfname, win_name, filt_expr, srchterm 
  114.     * from FoxApp's generated SETUP program
  115.  
  116.     RELEASE act3 && from APPCNTRL
  117.  
  118.     RELEASE m.skipvar  && from APPMENU
  119.              
  120.     * DO other cleanup here
  121.     
  122.     ACTIVATE SCREEN 
  123.     FOR x = 4 TO 40 STEP .5
  124.       y = INT(x)
  125.       @ 4,y CLEAR TO 20,y
  126.       @ 4,80-y CLEAR TO 20,80-y
  127.     ENDFOR 
  128.     POP KEY
  129. ENDIF        
  130. RETURN
  131.  
  132. PROC widghelp
  133. PARAMETERS thisvar, thisprompt, thiswind, thisfile, thistitle
  134. PUSH KEY CLEAR
  135. * assign help topics with your highest priority first,
  136. * since only the first case that evaluates .T. will be 
  137. * processed -- and you can do the same thing within a 
  138. * SET TOPIC expression, as if the ORs were CASEs
  139.  
  140. * as usual the use of SET TOPIC in only one case and 
  141. * SET HELPFILTER in the others is not meant to teach you
  142. * to use different systems all over the place;
  143. * it's just to demonstrate different approaches and capabilities
  144. * using this one sample system
  145.  
  146. DO CASE
  147. CASE "Pick" $ thistitle
  148.    * in a driver Browse during data entry:
  149.    SET HELPFILTER AUTOMATIC TO ATC(thisfile,topic) > 0 OR ;
  150.        Topic = "Browse"
  151.    * Notice no quotes:       
  152.    HELP Browse
  153. CASE RDLEVEL() > 1
  154.    SET HELPFILTER AUTOMATIC TO ;
  155.                 ATC(thisvar,readitem) > 0 OR ;
  156.                 ATC(thistitle,topic) > 0 OR ; 
  157.                 ATC(ALLTRIM(windobj),thiswind) > 0  OR ;
  158.                 thisfile = currfile OR ;
  159.                 ATC(ALLTRIM(menuitem), thisprompt) > 0 OR ;
  160.                 ATC(thisfile,topic) > 0 
  161.    * is there a topic written for this GET?
  162.    * (we only did one sample, query1, in widghelp)
  163.    SET TOPIC TO ATC(thisvar, readitem) > 0                
  164.    HELP                
  165.    SET TOPIC TO
  166. CASE RDLEVEL() = 1
  167.    IF ! EMPTY(thisfile)
  168.       WAIT WINDOW NOWAIT "Current table is "+PROPER(thisfile)+"... "
  169.    ENDIF
  170.    SET HELPFILTER AUTOMATIC TO ;
  171.                  AT("═",topic) > 0 OR ;
  172.                  ATC(thisfile,currfile) > 0 OR ;
  173.                  ATC(ALLTRIM(menuitem), thisprompt) > 0 
  174.    HELP                
  175. ENDCASE        
  176. POP KEY
  177. RETURN
  178.  
  179.  
  180. PROC widgerror
  181. PARAMETERS errlineno, errprog, errmsg, errline, ;
  182.            errno, lastwind, readwind, topwind, readno
  183.  
  184. * If you are in the habit of using SET PRINT, SET CONSOLE, or
  185. * SET DEVICE, you may have to 
  186.   * SET PRINT OFF
  187.   * SET CONSOLE ON
  188.   * SET DEVICE TO SCREEN
  189. * here and restore state later as necessary.  (However, CONSOLE
  190. * is automatically SET ON by an ON ERROR program, so there is
  191. * no problem with the messages and WAIT WINDOWS herein being 
  192. * displayed.)  The procedures here and elsewhere in the WIDGET
  193. * rely on the ... TO <target device> clauses and NOCONSOLE keyword
  194. * in specific commands rather than SETting PRINT or CONSOLE or
  195. * DEVICE, which obviates this problem to a great degree.
  196.  
  197. errpdset = _PDSETUP
  198.  
  199. * The printer driver setup is removed and later
  200. * restored in case a PostScript driver is installed,
  201. * which would make the LISTings of MEMO and STATUS
  202. * very difficult to read... see the PDCHECK program
  203. * in the QDISK\MISC directory for an expanded look
  204. * at saving printer driver-related information at
  205. * error time, or any time.  Much of that routine
  206. * could be incorporated here.
  207.  
  208. errtalk = SET("TALK")
  209. * one or two of the procedures may SET TALK ON temporarily
  210. * such as PACKing...
  211.  
  212. SET TALK OFF
  213. SET PDSETUP TO ""
  214.  
  215. * Sound a "uh-oh" sound of some sort, 
  216. * distinctive from other bells in your application
  217. * This particular syntax is courtesy of Hallie Steiner Cooper,
  218. * age 3 and a half <g>.
  219.  
  220. = belltone(328,3)
  221. = belltone(261,8)
  222.  
  223. PRIVATE lowmem, errstr
  224. PRIVATE all like ????_errs
  225.  
  226. errstr = "/" + ltrim(str(errno)) + "/"
  227. lowmem = (val(sys(1001))-val(sys(1016)) < 10000)
  228.  
  229. * add or edit the following list as necessary
  230. memo_errs = "/43/1012/1149/1150/1151/1600/"
  231. indx_errs = "/5/19/20/114/1707/"
  232. disk_errs = "/1410/"
  233. file_errs = "/1/15/41/111/1115/1294/1643/1644/1705/"
  234. netw_errs = "/124/1705/"
  235. lock_errs = "/3/108/109/110/1502/1708/"
  236. prtr_errs = "/125/"
  237. drvr_errs = "/1910/1643/1644/1717/"
  238.  
  239. * take care of a trivial problem like this:
  240. IF errstr $ prtr_errs
  241.    err_ask = ASK("The printer is not ready; RETRY or CANCEL?",;
  242.                   "RETRY ","@M  RETRY, CANCEL")
  243.    DO err_reset                  
  244.    IF "R" $ err_ask 
  245.       RETRY
  246.    ELSE
  247.       * you may want to set a public variable in 
  248.       * here that indicates that a print job was cancelled,
  249.       * as below for the record locking
  250.       RETURN
  251.    ENDIF
  252. ENDIF   
  253.  
  254. * take care of a normal situation that generates an error
  255. * condition like this:
  256. IF errstr $ lock_errs
  257.    err_ask = ASK("Record/file in use; RETRY or CANCEL?",;
  258.                   "RETRY ","@M  RETRY, CANCEL")
  259.    DO err_reset                                    
  260.    IF "R" $ err_ask 
  261.       RETRY
  262.    ELSE
  263.       got_cancel = .T.
  264.       RETURN
  265.    ENDIF
  266. ENDIF
  267.  
  268. * take care of other classes of errors like this:
  269. WAIT CLEAR
  270. SET COLOR OF SCHEME 5 TO SCHEME 7
  271. * Set WAIT WINDOW colors to alert colors, for a clear difference,
  272. * or create a standard ALERT.SCX and use that instead --
  273. * An ALERT.SCX will allow you to provide a fuller explanation
  274. * of the class of error that has occurred than the one-line
  275. * standard WAIT WINDOW, but keep in mind that an ALERT.SCX 
  276. * will require more memory than the WAIT WINDOW if you choose
  277. * to use it.
  278.  
  279. DO CASE   
  280.  
  281. * take care of an important but recoverable problem like this:
  282. CASE UPPER(errprog) = "FILEOPEN"
  283.    * FileOpen would be a procedure that opened all
  284.    * files for your system as necessary
  285.    * Here, you'd need to take care
  286.    * of structural index not found, creating files not
  287.    * found, etc
  288. CASE errstr $ indx_errs
  289.    WAIT WINDOW NOWAIT "Index file error detected; re-creating indexes..."
  290.    * put a re-building index program here
  291.    WAIT CLEAR
  292. CASE errstr $ drvr_errs
  293.    * printer driver errors will be handled differently
  294.    * depending on in which way you use FP's sample printer driver
  295.    * system -- or if, instead, you have written your own _GENPD or
  296.    * _PDRIVER.  See Chapter 15, and PDCHECK.PRG in the 
  297.    * \MISC directory of the source disk, for appropriate
  298.    * items to check when printer driver problems are suspected.
  299.  
  300. * take care of unrecoverable errors such as out of
  301. * memory, disk, corrupted problem files, like this:
  302. CASE errno = 1309
  303.    WAIT WINDOW ;
  304.       "There is a problem with your program files.  Please re-install."
  305.  
  306. ENDCASE
  307.  
  308. * check for unrecoverable errors that cannot be logged:
  309. IF lowmem OR INLIST(errno, 1309, 56) && make your own list!
  310.    * write a limited log, as per instructions below,
  311.    * to the printer if possible first
  312.    WAIT WINDOW UPPER(PROGRAM(0))+;
  313.                " cannot recover from this error; "+;
  314.                "press a key to clean up & exit."
  315.    CLOSE ALL
  316.    ERASE (m.oldvue)
  317.    QUIT
  318. ENDIF
  319.  
  320. * otherwise write a log for future use:
  321. WAIT WINDOW NOWAIT ;
  322.   "A program exception has occurred; writing error log... "
  323. xselect = SELECT()
  324. IF USED("errlog")
  325.    SELECT errlog
  326. ELSE
  327.    IF FILE("errlog.dbf") AND FILE("errlog.fpt")
  328.       SELECT 0
  329.       USE errlog
  330.    ELSE 
  331.       CREATE TABLE errlog ;
  332.              (errdate   d(8), ;
  333.               errtime   c(8), ;
  334.               snapshot  m(10), ;
  335.               listing   m(10), ;
  336.               usernotes m(10))              
  337.    ENDIF
  338. ENDIF                       
  339. APPEND BLANK
  340. IF RLOCK()
  341.   * You don't need this RLOCK() and UNLOCK
  342.   * if your version of FoxPro 2 is later than October 1991,
  343.   * so get rid of them if possible!
  344.   * SAVE WINDOWS or MACROS TO MEMO... now does an automatic
  345.   * record lock in the same way as a normal REPLACE or
  346.   * APPEND MEMO... FROM does
  347.   * This RLOCK() is only included in case you have not
  348.   * updated your copy of FoxPro because errors within
  349.   * an error program are so annoying and difficult to
  350.   * recover from cleanly.  In most other parts of the 
  351.   * source code, we have not attempted to compensate for
  352.   * version differences.  Caveat emptor!
  353.  
  354.   SAVE WINDOWS ALL TO MEMO snapshot
  355.  
  356.   UNLOCK
  357. ENDIF
  358. REPLACE errdate WITH DATE(), errtime WITH TIME()
  359.  
  360. * create listing memo field from chunks of data --
  361. * do a couple of REPLACEs so that less memory is
  362. * used for each step of this process
  363.  
  364. errdata =        'error number='+ALLTRIM(STR(errno))
  365. errdata = errdata+CHR(13)+'error message='+errmsg
  366. errdata = errdata+CHR(13)+'last error parameter='+SYS(2018)
  367. errdata = errdata+CHR(13)+'program=  '+ errprog
  368. errdata = errdata+CHR(13)+'lineno=  '+;
  369.                           ALLTRIM(STR(errlineno))+":  "+errline
  370. REPLACE listing WITH errdata   
  371.  
  372. errdata =         CHR(13)+'bof='+IIF(BOF(),"YES","NO")
  373. errdata = errdata+CHR(13)+ 'eof='+IIF(EOF(),"YES","NO")
  374. errdata = errdata+CHR(13)+'last window='+lastwind
  375. errdata = errdata+CHR(13)+'top window '+IIF(EMPTY(topwind),;
  376.                            'SCREEN ',UPPER(topwind))+;
  377.                            IIF(readwind, '*is*','*is NOT*')+;
  378.                            ' involved in current READ'
  379. REPLACE listing WITH errdata ADDITIVE                           
  380.  
  381. errdata =         CHR(13)+'read level='+ALLTRIM(STR(readno))
  382. errdata = errdata+CHR(13)+ 'rec. no.='+ALLTRIM(STR(RECNO()))
  383. errdata = errdata+CHR(13)+ 'diskspace='+ALLTRIM(STR(DISKSPACE(),25))
  384. errdata = errdata+CHR(13)+ 'os='+OS()
  385. errdata = errdata+CHR(13)+ 'ver='+VERSION(1)
  386. REPLACE listing WITH errdata ADDITIVE                           
  387.  
  388. errdata =         CHR(13)+ ALLTRIM(STR(VAL(SYS(1016))/1024))+;
  389.                            "K memory in use by user objects"
  390. errdata = errdata+CHR(13)+ ALLTRIM(STR(VAL(SYS(12))/1024))+;
  391.                            "K memory remaining"
  392. errdata = errdata+CHR(13)+ ALLTRIM(STR(VAL(SYS(1001))/1024))+;
  393.                            "K total memory available to Fox"
  394. errdata = errdata+CHR(13)+ IIF(EMPTY(errpdset),"NO",errpdset)+;
  395.                            " Printer Driver Installed"
  396. REPLACE listing WITH errdata ADDITIVE                              
  397.  
  398. errdata =         CHR(13)+ 'processor='+ SYS(17)
  399. errdata = errdata+CHR(13)+ 'video card/monitor='+SYS(2006)
  400. errdata = errdata+CHR(13)+ 'FILES='+SYS(2010)
  401. errdata = errdata+CHR(13)+CHR(13)+REPLICATE('=',50)
  402. errdata = errdata+CHR(13)+'            Status listing'
  403. errdata = errdata+CHR(13)+REPLICATE('=',50)+CHR(13)
  404. REPLACE listing WITH errdata ADDITIVE                           
  405.  
  406. RELEASE errdata
  407.  
  408. IF TYPE("gramdisk") # "C"
  409.    * gramdisk would be a variable you'd let 
  410.    * them specify a workdisk with during setup;
  411.    * would have complete pathspec in it
  412.    gramdisk = ""
  413. ENDIF   
  414. tempfile = gramdisk+SYS(3)+".tmp"
  415. DO WHILE FILE(tempfile)
  416.    tempfile = gramdisk+SYS(3)+".tmp"
  417. ENDDO   
  418.  
  419. LIST STATUS TO (tempfile) NOCONSOLE
  420. APPEND MEMO listing FROM (tempfile) 
  421. * APPEND MEMO is ADDITIVE by default
  422.  
  423. ERASE (tempfile)
  424. * just in case SAFETY is still ON 
  425. * if an error occurs at the very beginning of the program!
  426.  
  427. REPLACE listing WITH CHR(13)+REPLICATE('=',50)+CHR(13)+;
  428.                 '            Memory listing'+CHR(13)+;
  429.                 REPLICATE('=',50)+CHR(13) ;
  430.                 ADDITIVE
  431.  
  432. LIST MEMORY TO (tempfile) NOCONSOLE
  433. APPEND MEMO listing FROM (tempfile)  
  434.  
  435. * add blank user questionnaire of some type 
  436. * to the user-editable memo field
  437. APPEND MEMO usernotes FROM survey.txt
  438. SELECT (xselect)
  439. ERASE (tempfile)
  440. WAIT CLEAR
  441. SET COLOR OF SCHEME 5 TO
  442. * re-set system parameters here as necessary
  443. * and, if you have been event-handling in several
  444. * apparent READs saving state in all of them, cancel
  445. * all changes and CLEAR READ ALL
  446.  
  447. * if your foundation READ is inside a Fndation.SPR called by
  448. * your main program, which paints a logo before
  449. * issuing the main READ, you would change the following to
  450. * RETURN TO Fndation.SPR
  451. DO err_reset                  
  452. RETURN TO MASTER
  453.  
  454. FUNCTION belltone
  455. PARAMETERS f,d
  456. * from Tom Rettig's FoxPro Handbook, with an additional check
  457. * to save & restore bell setting
  458. STORE SET("BELL") TO oldbell
  459. SET BELL ON
  460. SET BELL TO f,d
  461. ?? CHR(7)
  462. SET BELL &oldbell
  463. SET BELL TO
  464. * if you routinely leave BELL ON for other activities,
  465. * you need to set the tones back to default or to whatever
  466. * you *use* for a default.  SET("BELL",1) will not give you
  467. * this information, unfortunately!
  468. RETURN ""
  469.  
  470. PROC err_reset
  471. SET TALK &errtalk
  472. SET PDSETUP TO errpdset
  473. RETURN